home *** CD-ROM | disk | FTP | other *** search
/ START Magazine / START VOL 3 NO 12.st / THEREMIN.ARC / THEREMIN.LST next >
Encoding:
File List  |  1989-04-11  |  10.9 KB  |  397 lines
  1. ' *******************************************************************
  2. ' *                                                                 *
  3. ' *                                                                 *
  4. ' *                      T H E R E M I N . B A S                    *
  5. ' *                                                                 *
  6. ' *               by Sterling K. Webb & SKWare One, Inc.            *
  7. ' *                  Copyright 1989 Antic Publishing                *
  8. ' *                                                                 *
  9. ' *                                                                 *
  10. ' *******************************************************************
  11. '
  12. ' for the making of a mouse
  13. Dim Cursor$(16),Mask$(16)
  14. ' parameters for the three resolutions
  15. Yf%=(Xbios(4)\2)+1
  16. Xf%=((Xbios(4)+1)\2)+1
  17. Max_x%=Xf%*319+(Xf%-1)
  18. Max_y%=Yf%*199+(Yf%-1)
  19. ' default typesize
  20. If Xbios(4)<2
  21.   Ty%=6
  22. Else
  23.   Ty%=13
  24. Endif
  25. Deftext 1,0,0,Ty%
  26. ' save user's palette
  27. U$=""
  28. For I%=0 To 15
  29.   U$=U$+Mki$(Xbios(7,I%,-1))
  30. Next I%
  31. ' set colors for the three resolutions
  32. If Xbios(4)=0
  33.   Setcolor 0,0,0,0
  34.   Setcolor 1,7,0,0
  35.   Setcolor 15,7,7,7
  36.   Setcolor 2,7,7,0
  37.   For I%=3 To 14
  38.     Setcolor I%,7,7,0
  39.   Next I%
  40. Else
  41.   If Xbios(4)=1
  42.     Setcolor 0,0,0,0
  43.     Setcolor 1,7,0,0
  44.     Setcolor 3,7,7,7
  45.     Setcolor 2,7,7,0
  46.   Else
  47.     Setcolor 0,0,0,0
  48.     Setcolor 1,7,7,7
  49.   Endif
  50. Endif
  51. ' translation unit for frequency value
  52. Unit=4048/(Max_x%+1)
  53. ' four pitch scales for mouse
  54. Dim Pitch_button$(4)
  55. Pitch_button$(0)="  Theremin  "
  56. Pitch_button$(1)="    Scale   "
  57. Pitch_button$(2)="   Whistle  "
  58. Pitch_button$(3)=" Multi-Band "
  59. ' define a new mouse
  60. Gosub Mouse(3)
  61. Defmouse Mouse$
  62. ' draw the screen
  63. ' first, the desktop
  64. Deffill 2,2,8\Yf%
  65. Gosub Grow_box(Max_x%\2,Max_y%\2,2,2,0,0,Max_x%,Max_y%)
  66. @Pbox(0,0,Max_x%,Max_y%)
  67. ' pitch wand
  68. @Rbox(280,28,315,34)
  69. ' pitch condenser
  70. @Rbox(130,9,265,49)
  71. ' pitch insulators
  72. @Rbox(265,14,275,45)
  73. @Rbox(275,14,285,45)
  74. ' case
  75. @Rbox(30,49,265,179)
  76. ' volume wand
  77. @Rbox(82,4,88,45)
  78. ' volume insulators
  79. @Rbox(65,40,105,50)
  80. @Rbox(65,50,105,59)
  81. ' volume condenser
  82. @Rbox(42,60,128,99)
  83. @Border_box(53,70,118,89)
  84. Deftext 2,0,0,Ty%
  85. @Center(53*Xf%,118*Xf%,82*Yf%,"Volume")
  86. ' base
  87. @Rbox(27,179,273,183)
  88. @Rbox(20,183,279,189)
  89. ' pitch control panel
  90. @Border_box(140,19,255,139)
  91. @Border_box(150,26,245,50)
  92. @Center(150*Xf%,245*Xf%,41*Yf%,"Pitch")
  93. Deftext 1,0,0,Ty%
  94. ' pitch scale selector buttons
  95. For I%=0 To 3
  96.   @Radio_button(148*Xf%+48*(Xf%-1),59*Yf%+I%*20*Yf%,Pitch_button$(I%))
  97. Next I%
  98. ' default to Theremin and Sound ON
  99. I%=0
  100. @Push_this_button(148*Xf%+48*(Xf%-1),59*Yf%+I%*20*Yf%,Pitch_button$(I%))
  101. @Radio_button(148*Xf%+24*(Xf%-1),150*Yf%,"POWER")
  102. @Push_this_button(148*Xf%+24*(Xf%-1),150*Yf%,"POWER")
  103. @Radio_button(205*Xf%+24*(Xf%-1),150*Yf%,"SOUND")
  104. @Push_this_button(205*Xf%+24*(Xf%-1),150*Yf%,"SOUND")
  105. ' name plate
  106. @Rbox(43,103,128,174)
  107. @Rivet(47*Xf%,107*Yf%)
  108. @Rivet(124*Xf%,107*Yf%)
  109. @Rivet(47*Xf%,170*Yf%)
  110. @Rivet(124*Xf%,170*Yf%)
  111. Deftext 2,4,0,Ty%
  112. @Center(43*Xf%,128*Xf%,118*Yf%,"Universal")
  113. @Center(43*Xf%,128*Xf%,128*Yf%,"Theremin")
  114. @Center(43*Xf%,128*Xf%,138*Yf%,"Company")
  115. Deftext 3,0,0,Ty%
  116. @Center(43*Xf%,128*Xf%,155*Yf%,"SKWare")
  117. @Center(43*Xf%,128*Xf%,165*Yf%,"One")
  118. If Ty%=6
  119.   Deftext 0,0,0,4
  120. Else
  121.   Deftext 0,0,0,6
  122. Endif
  123. Graphmode 2
  124. A1$=Chr$(189)+" 1989 Antic Publishing"
  125. @Center(80*Xf%,256*Xf%,197*Yf%,A1$)
  126. Graphmode 1
  127. Deftext 1,0,0,Ty%
  128. ' sound routine
  129. Do
  130.   ' read volume from y-coordinate of mouse
  131.   Vol=((Max_y%-Mousey)\22*Yf%)+6
  132.   If Button%=0
  133.     Per=Int((Max_x%+1-Mousex)*Unit)+12
  134.     Sound 1,Vol,#Per
  135.   Endif
  136.   If Button%=1
  137.     Noet=Int((Mousex/(Max_x%+1))*96)+1
  138.     Oct=(Noet\12)+1
  139.     Noet=(Noet Mod 12)+1
  140.     Sound 1,Vol,Noet,Oct
  141.   Endif
  142.   If Button%=2
  143.     Per=4*Int(Log(Max_x%+1-Mousex)*Unit)+125
  144.     Sound 1,Vol,#Per
  145.   Endif
  146.   If Button%=3
  147.     Per=Int((Max_x%+1-Mousex)*Unit)+12
  148.     Per=Per*Log(Per)
  149.     Sound 1,Vol,#Per
  150.   Endif
  151.   ' check for buttons clicked
  152.   If Mousek=1
  153.     Gosub Check_it_out
  154.   Endif
  155. Loop
  156. Procedure Check_it_out
  157.   ' check the pitch scale selector buttons
  158.   Gosub Pitch_scale_select
  159.   ' check the power switch
  160.   @In_box(148*Xf%+24*(Xf%-1),150*Yf%,148*Xf%+24*(Xf%-1)+42+14*(Xf%-1),160*Yf%)
  161.   If In_box%=True And Mousek=1
  162.     Gosub Switch_off
  163.   Endif
  164.   ' check the sound switch
  165.   @In_box(205*Xf%+24*(Xf%-1),150*Yf%,205*Xf%+24*(Xf%-1)+42+14*(Xf%-1),160*Yf%)
  166.   If In_box%=True And Mousek=1
  167.     @Click_stopper
  168.     ' turn the sound switch OFF
  169.     @Push_this_button(205*Xf%+24*(Xf%-1),150*Yf%,"SOUND")
  170.     Wave 0
  171.     ' while the sound switch is off, keep checking the other buttons...
  172.     Repeat
  173.       ' check if the sound switch is turned back on
  174.       @In_box(205*Xf%+24*(Xf%-1),150*Yf%,205*Xf%+24*(Xf%-1)+42+14*(Xf%-1),160*Yf%)
  175.       If In_box%=True And Mousek=1
  176.         Flag%=1
  177.       Endif
  178.       Exit If Flag%=1
  179.       ' check the pitch scale selector buttons
  180.       Gosub Pitch_scale_select
  181.       ' check the power switch
  182.       @In_box(148*Xf%+24*(Xf%-1),150*Yf%,148*Xf%+24*(Xf%-1)+42+14*(Xf%-1),160*Yf%)
  183.       If In_box%=True And Mousek=1
  184.         Gosub Switch_off
  185.       Endif
  186.     Until In_box%=True And Mousek=1
  187.     Clr Flag%
  188.     @Click_stopper
  189.     ' turn the sound switch back ON
  190.     @Push_this_button(205*Xf%+24*(Xf%-1),150*Yf%,"SOUND")
  191.   Endif
  192. Return
  193. Procedure Pitch_scale_select
  194.   ' each in turn...
  195.   For I%=0 To 3
  196.     @In_box(148*Xf%+48*(Xf%-1),59*Yf%+I%*20*Yf%,148*Xf%+48*(Xf%-1)+116,59*Yf%+I%*20*Yf%+10*Yf%)
  197.     If In_box%=True And Mousek=1
  198.       ' old button OFF
  199.       @Push_this_button(148*Xf%+48*(Xf%-1),59*Yf%+Button%*20*Yf%,Pitch_button$(Button%))
  200.       Button%=(Mousey-(59*Yf%))\(20*Yf%)
  201.       ' new button ON
  202.       @Push_this_button(148*Xf%+48*(Xf%-1),59*Yf%+Button%*20*Yf%,Pitch_button$(Button%))
  203.       Gosub Click_stopper
  204.     Endif
  205.   Next I%
  206. Return
  207. Procedure Switch_off
  208.   ' turn the power switch OFF
  209.   @Push_this_button(148*Xf%+24*(Xf%-1),150*Yf%,"POWER")
  210.   ' power pop
  211.   Sound 1,15,#Per,1
  212.   Wave 56,7,11,10,10
  213.   Wave 0,0
  214.   Pause 20
  215.   Deffill 2,2,8\Yf%
  216.   @Pbox(0,0,Max_x%,Max_y%)
  217.   Gosub Shrink_box(Max_x%\2,Max_y%\2,2,2,0,0,Max_x%,Max_y%)
  218.   Void Xbios(6,L:Varptr(U$))
  219.   Defmouse 0
  220.   Edit
  221. Return
  222. ' GEM's visual
  223. Procedure Grow_box(C1%,C2%,C3%,C4%,C5%,C6%,C7%,C8%)
  224.   Dpoke Gcontrl,73
  225.   Dpoke Gcontrl+2,8
  226.   Dpoke Gcontrl+4,1
  227.   Dpoke Gcontrl+6,0
  228.   Dpoke Gcontrl+8,0
  229.   Dpoke Gintin,C1%
  230.   Dpoke Gintin+2,C2%
  231.   Dpoke Gintin+4,C3%
  232.   Dpoke Gintin+6,C4%
  233.   Dpoke Gintin+8,C5%
  234.   Dpoke Gintin+10,C6%
  235.   Dpoke Gintin+12,C7%
  236.   Dpoke Gintin+14,C8%
  237.   Gemsys    ! Grow a wibble box
  238. Return
  239. ' inverse of above...
  240. Procedure Shrink_box(C1%,C2%,C3%,C4%,C5%,C6%,C7%,C8%)
  241.   Dpoke Gcontrl,74
  242.   Dpoke Gcontrl+2,8
  243.   Dpoke Gcontrl+4,1
  244.   Dpoke Gcontrl+6,0
  245.   Dpoke Gcontrl+8,0
  246.   Dpoke Gintin,C1%
  247.   Dpoke Gintin+2,C2%
  248.   Dpoke Gintin+4,C3%
  249.   Dpoke Gintin+6,C4%
  250.   Dpoke Gintin+8,C5%
  251.   Dpoke Gintin+10,C6%
  252.   Dpoke Gintin+12,C7%
  253.   Dpoke Gintin+14,C8%
  254.   Gemsys    ! Un-grow a wibble box
  255. Return
  256. ' centers text between starting and finishing x-coordinates
  257. Procedure Center(Sx%,Fx%,Tl%,Text$)
  258.   Pos%=Sx%+Int(((Fx%-Sx%)/2)-((Len(Text$)/2)*8))
  259.   Text Pos%,Tl%,Text$
  260. Return
  261. ' don't all talk at once, dammit!
  262. Procedure Click_stopper
  263.   Repeat
  264.   Until Mousek=0
  265. Return
  266. ' this is a simplified equivalent of GRAF_WATCHBOX,
  267. ' but does not require objects in trees or a RSC file.
  268. Procedure In_box(C1%,C2%,C3%,C4%)
  269.   Z%=False
  270.   If Mousex=>C1% And Mousex=<C3% And Mousey=>C2% And Mousey=<C4%
  271.     Z%=True
  272.   Endif
  273.   In_box%=Z%
  274. Return
  275. ' highlights a button
  276. Procedure Button(C1%,C2%,C3%,C4%)
  277.   Get C1%,C2%,C3%,C4%,Inv$
  278.   Put C1%,C2%,Inv$,12
  279.   @Click_stopper
  280. Return
  281. ' draws the radio button, given a starting x-and-y-coordinate and button text
  282. Procedure Radio_button(C1%,C2%,C$)
  283.   C3%=C1%+Len(C$)*8+2+(Xf%-1)*14
  284.   C4%=C2%+10*Yf%
  285.   @Blank_it
  286.   If Rez%=1
  287.     Pbox C1%-2,C2%-2,C3%+4,C4%+3
  288.   Else
  289.     Pbox C1%-2,C2%-2,C3%+3,C4%+3
  290.   Endif
  291.   Box C1%,C2%,C3%,C4%
  292.   Box C1%-2,C2%-2,C3%+2,C4%+2
  293.   Box C1%-2,C2%-2,C3%+3,C4%+3
  294.   If Rez%=1
  295.     Box C1%-2,C2%-2,C3%+4,C4%+3
  296.   Endif
  297.   Text C1%+1+(Xf%-1)*7,C2%+8*Yf%,C$
  298. Return
  299. ' highlights the radio button when pushed...
  300. Procedure Push_this_button(C1%,C2%,C$)
  301.   C3%=C1%+Len(C$)*8+2+(Xf%-1)*14
  302.   C4%=C2%+10*Yf%
  303.   Get C1%,C2%,C3%,C4%,Inv$
  304.   Put C1%,C2%,Inv$,12
  305. Return
  306. Procedure Box(C1%,C2%,C3%,C4%)
  307.   Box C1%,C2%,C3%,C4%
  308. Return
  309. Procedure Pbox(C1%,C2%,C3%,C4%)
  310.   Pbox C1%,C2%,C3%,C4%
  311. Return
  312. Procedure Blank_it
  313.   Deffill 0,2,8
  314. Return
  315. Procedure Write_color
  316.   Color 1
  317. Return
  318. Procedure Mouse(A%)
  319.   Let Mouse$=""
  320.   Let Mouse$=Mki$(1)+Mki$(15)+Mki$(0)+Mki$(0)+Mki$(A%)
  321.   ' here's the cursor
  322.   ' its pattern fairly visible in this format
  323.   Cursor$(0)=Mki$(Val("&X0000000000000000"))
  324.   Cursor$(1)=Mki$(Val("&X0000000001111110"))
  325.   Cursor$(2)=Mki$(Val("&X0000000011111100"))
  326.   Cursor$(3)=Mki$(Val("&X0000000111111000"))
  327.   Cursor$(4)=Mki$(Val("&X0000001111111100"))
  328.   Cursor$(5)=Mki$(Val("&X0000000011111000"))
  329.   Cursor$(6)=Mki$(Val("&X0000000111110000"))
  330.   Cursor$(7)=Mki$(Val("&X0000001111100000"))
  331.   Cursor$(8)=Mki$(Val("&X0000011111000000"))
  332.   Cursor$(9)=Mki$(Val("&X0000111111110000"))
  333.   Cursor$(10)=Mki$(Val("&X0000011111000000"))
  334.   Cursor$(11)=Mki$(Val("&X0000111100000000"))
  335.   Cursor$(12)=Mki$(Val("&X0001110000000000"))
  336.   Cursor$(13)=Mki$(Val("&X0011000000000000"))
  337.   Cursor$(14)=Mki$(Val("&X0100000000000000"))
  338.   Cursor$(15)=Mki$(Val("&X0000000000000000"))
  339.   ' here's the mask
  340.   Mask$(0)=Mki$(Val("&X0000000001111111"))
  341.   Mask$(1)=Mki$(Val("&X0000000011111111"))
  342.   Mask$(2)=Mki$(Val("&X0000000111111110"))
  343.   Mask$(3)=Mki$(Val("&X0000001111111110"))
  344.   Mask$(4)=Mki$(Val("&X0000011111111110"))
  345.   Mask$(5)=Mki$(Val("&X0000011111111100"))
  346.   Mask$(6)=Mki$(Val("&X0000001111111000"))
  347.   Mask$(7)=Mki$(Val("&X0000011111110000"))
  348.   Mask$(8)=Mki$(Val("&X0000111111111000"))
  349.   Mask$(9)=Mki$(Val("&X0001111111111100"))
  350.   Mask$(10)=Mki$(Val("&X0011111111110000"))
  351.   Mask$(11)=Mki$(Val("&X0001111111000000"))
  352.   Mask$(12)=Mki$(Val("&X0011111100000000"))
  353.   Mask$(13)=Mki$(Val("&X0111110000000000"))
  354.   Mask$(14)=Mki$(Val("&X1111000000000000"))
  355.   Mask$(15)=Mki$(Val("&X1100000000000000"))
  356.   ' put'em together sequentially...
  357.   For I%=0 To 15
  358.     Let Mouse$=Mouse$+Mask$(I%)
  359.   Next I%
  360.   For I%=0 To 15
  361.     Let Mouse$=Mouse$+Cursor$(I%)
  362.   Next I%
  363. Return
  364. Procedure Rbox(C1%,C2%,C3%,C4%)
  365.   ' adapt for resolution
  366.   C1%=C1%*Xf%
  367.   C3%=C3%*Xf%
  368.   C2%=C2%*Yf%
  369.   C4%=C4%*Yf%
  370.   @Prbox(C1%,C2%,C3%,C4%)
  371.   @Write_color
  372.   Rbox C1%,C2%,C3%,C4%
  373. Return
  374. Procedure Prbox(C1%,C2%,C3%,C4%)
  375.   @Blank_it
  376.   Prbox C1%+2,C2%+2,C3%+2,C4%+2
  377.   Prbox C1%,C2%,C3%,C4%
  378. Return
  379. Procedure Border_box(C1%,C2%,C3%,C4%)
  380.   ' adapt for resolution
  381.   C1%=C1%*Xf%
  382.   C3%=C3%*Xf%
  383.   C2%=C2%*Yf%
  384.   C4%=C4%*Yf%
  385.   @Blank_it
  386.   @Pbox(C1%,C2%,C3%,C4%)
  387.   @Box(C1%,C2%,C3%,C4%)
  388.   @Box(C1%+2,C2%+2,C3%-2,C4%-2)
  389.   @Box(C1%+3,C2%+3,C3%-3,C4%-3)
  390. Return
  391. Procedure Rivet(C1%,C2%)
  392.   @Blank_it
  393.   Pcircle C1%,C2%,3
  394.   @Write_color
  395.   Circle C1%,C2%,2
  396. Return
  397.